home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
PASCAL
/
0921.ZIP
/
QWIK40.ARC
/
QINITEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-12-01
|
5KB
|
162 lines
{ Qinitest.pas - tests your system configuration ver 4.0, 12-01-87 }
program Qinitest;
uses
Crt, {$U Qwik40.tpu} Qwik;
type
Str9 = string[9];
var
CursorMode: integer absolute $0040:$0060;
b,OldVideoMode: byte;
Strng: string;
ch: char;
function DecToHex (Number: longint; Nibbles: byte): str9;
const
D2H: array[0..$0F] of char = ('0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F');
var
BuildStr: Str9;
Mask: longint;
Nibs,Bits: byte;
begin
BuildStr:='$';
Mask:=$F;
for Nibs:=pred(Nibbles) downto 0 do
begin
Bits:=Nibs shl 2;
BuildStr:=BuildStr + D2H[(Number and (Mask shl Bits)) shr Bits];
end;
DecToHex:=BuildStr;
end;
procedure DisplayDev (DD: byte);
begin
case DD of
$00: Strng:='No display';
$01: Strng:='MDA with 5151 monochrome';
$02: Strng:='CGA with 5153/4 color';
$04: Strng:='EGA with 5153/4 color';
$05: Strng:='EGA with 5151 monochrome';
$06: Strng:='PGC with 5175 color';
$07: Strng:='VGA with analog monochrome';
$08: Strng:='VGA with analog color';
$0B: Strng:='MCGA with analog monochrome';
$0C: Strng:='MCGA with analog color';
else Strng:='Reserved';
end; { case }
end;
begin
OldVideoMode:=VideoMode;
NormVideo;
Qfill (1,1,25,CRTcols,TextAttr,' ');
Qwrite (1,1,-1,'Which text mode [0,1,2,3,7] ? ');
GotoRC (1,31);
repeat
Ch:=readkey;
until Ch in ['0'..'3','7'];
b:=ord(Ch)-ord('0');
if b<>OldVideoMode then
begin
TextMode(b);
Qinit;
end;
CheckSnow:=Qsnow;
Qfill (1,1,25,CRTcols,TextAttr,' ');
GotoRC (1,1);
case SystemID of
$FF: Strng:='IBM PC';
$FE: Strng:='IBM PC XT';
$FD: Strng:='IBM PCjr';
$FC: case SubModelID of
$00: Strng:='IBM PC AT (6 MHz)';
$01: Strng:='IBM PC AT (8 MHz)';
$02: Strng:='IBM PC XT (286)';
$04: Strng:='IBM PS/2 Model 50';
$05: Strng:='IBM PS/2 Model 60';
else Strng:='IBM PS/2 VGA type';
end;
$FB: Strng:='IBM PC XT (256/640)';
$FA: case SubModelID of
$00: Strng:='IBM PS/2 Model 30';
$01: Strng:='IBM PS/2 Model 25';
else Strng:='IBM PS/2 MCGA type';
end;
$F9: Strng:='IBM PC convertible';
$F8: case SubModelID of
$00: Strng:='IBM PS/2 Model 80 (16 MHz)';
$01: Strng:='IBM PS/2 Model 80 (20 MHz)';
else Strng:='IBM PS/2 Model 70/80 type';
end;
end; { case }
writeln ('System ID = ',DecToHex(SystemID,2));
writeln ('SubModel ID = ',SubModelID);
writeln (' ',Strng);
writeln ('PS/2 equipment = ',HavePS2);
writeln ('IBM 3270 PC = ',Have3270);
writeln ('Prior video mode = ',OldVideoMode);
writeln ('Video mode now = ',VideoMode);
writeln ('Wait-for-retrace = ',Qsnow);
writeln ('Max page # = ',MaxPage);
if Have3270 then
begin
writeln ('Disp Dev 3270 = ',DecToHex(ActiveDispDev3270,2));
case ActiveDispDev3270 of
$00: Strng:='5151 or 5272 display and adapter';
$01: Strng:='3295 display and adapter';
$02: Strng:='5151 or 5272, adapter, XGA graphics';
$03: Strng:='5279 display, 3270 PC G adapter';
$04: Strng:='5379 C01 display, 3270 PC GX adapter';
$05: Strng:='5379 M01 display, 3270 PC GX adapter';
$FF: Strng:='Unknown, not a 3270 PC';
else Strng:='Reserved';
end;
writeln (' ',Strng);
end
else
begin
DisplayDev (ActiveDispDev);
writeln ('Active Disp Dev = ',DecToHex(ActiveDispDev,2));
writeln (' ',Strng);
if SystemID=$F9 then
writeln ('Alt Disp Dev PC Conv = ',DecToHex(AltDispDevPCC,4))
else
begin
DisplayDev (AltDispDev);
writeln ('Alt Disp Dev = ',DecToHex(AltDispDev,2));
writeln (' ',Strng);
end;
writeln ('Hercules model = ',HercModel);
case HercModel of
0: Strng:='No Hercules card';
1: Strng:='Hercules Graphics Card';
2: Strng:='Hercules Graphics Card Plus';
3: Strng:='Hercules InColor Card';
end;
writeln (' ',Strng);
end;
writeln ('Cursor start = ',DecToHex(hi(CursorMode),2));
writeln ('Cursor end = ',DecToHex(lo(CursorMode),2));
writeln ('CRT rows = ',CRTrows);
writeln ('CRT columns = ',CRTcols);
if (ActiveDispDev>=EgaColor) and (ActiveDispDev<=McgaColor) then
begin
writeln ('EGA rows = ',EgaRows);
writeln ('EGA FontSize = ',EgaFontSize);
writeln ('EGA Info = ',DecToHex(EgaInfo,2));
writeln ('EGA Switches = ',DecToHex(EgaSwitches,2));
end;
writeln;
write ('Press any key...');
Ch:=ReadKey;
TextMode (OldVideoMode);
end.